home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / rlib20.zip / RL_PDOWN.PRG < prev    next >
Text File  |  1989-02-18  |  15KB  |  460 lines
  1. * Function..: PDOWNINIT
  2. * Author....: Richard Low
  3. * Syntax....: PDOWNINIT( row, columns, options, items, starts, prompts,;
  4. *                        promptrow, colors, altkeys, exit )
  5. *
  6. * Notes.....: Mandatory function to initialize PDOWNMENU for operation.
  7. *             Optional parameters are not required, but if you wish to skip
  8. *             an optional parameter, you must pass a dummy value.  The best
  9. *             dummy value to use is a null string '' (set up a memvar named
  10. *             dummy where dummy = '').
  11. *
  12. * Parameters: row       - NUMERIC row for top of Pull Down Menu to appear.
  13. *             columns   - ARRAY of column numbers for each top level option.
  14. *             options   - ARRAY of top level menu option choices.
  15. *             items     - ARRAY of pulled down menu items.
  16. *             starts    - ARRAY of starting element numbers.
  17. *             prompts   - Optional ARRAY corresponding menu item messages.
  18. *             promptrow - Optional NUMERIC row on which these messages appear.
  19. *             colors    - Optional ARRAY of colors to use for the top Bar and
  20. *                         pull down Box menus.
  21. *
  22. *                           color[1] - Option & message displays
  23. *                           color[2] - Menu selection bars
  24. *                           color[3] - Pull-down menu box ACTIVE color
  25. *                           color[4] - Pull-down menu box IN-ACTIVE color
  26. *                           color[5] - Pull-down menu option after selection
  27. *                           color[6] - Menu bar option after selection
  28. *
  29. *             altkeys   - Optional ARRAY of alternate select keys for each menu.
  30. *             exit      - Optional LOGICAL indicating if escape will exit menu.
  31. *
  32. * Returns...: True if initialization sucessful, False if parameters error.
  33. *
  34.  
  35. FUNCTION PDOWNINIT
  36. PARAMETERS prow, pcols, pmenus, pitems, pstarts, pprompts, promptrow,;
  37.            p_colors, paltkeys, pexit
  38.  
  39. IF PCOUNT() = 0
  40.    *-- if no parameters, release PUBLIC arrays to reclaim memory
  41.    RELEASE rl_pd, pd_counts, pd_altkeys, pd_bottoms, pd_rights
  42.    RETURN (.T.)
  43. ENDIF
  44.  
  45. *-- make sure that all the required parameters are the correct type
  46. IF TYPE('prow')   + TYPE('pcols')   + TYPE('pmenus') +;
  47.    TYPE('pitems') + TYPE('pstarts') != 'NAAAA'
  48.    RETURN (.F.)
  49. ENDIF
  50.  
  51. *-- the number of columns, top level options, starting array element
  52. *-- numbers, and menu item counts must all be the same
  53. IF .NOT. ( LEN(pcols) = LEN(pmenus) .AND. LEN(pcols) = LEN(pstarts) )
  54.    RETURN (.F.)
  55. ENDIF
  56.  
  57. *-- there must be more than one menu (get real)
  58. IF LEN(pcols) < 2
  59.    RETURN (.F.)
  60. ENDIF
  61.  
  62.  
  63. last_menu = LEN(pmenus)
  64. PUBLIC pd_counts[last_menu],  pd_altkeys[last_menu]
  65. PUBLIC pd_bottoms[last_menu], pd_rights[last_menu]
  66.  
  67.  
  68. *-- fill in menu item counts based on start numbers
  69. *-- can't start at 1 because of computational algorithm
  70. pd_counts[1] = pstarts[2] - 1
  71. FOR x = 2 TO last_menu - 1
  72.    *-- count of options in this menu equal next start number minus this start
  73.    pd_counts[x] = pstarts[x+1] - pstarts[x]
  74. NEXT x
  75. *-- number of items in last menu is equal to length of array - starting # + 1
  76. pd_counts[ last_menu ] = LEN(pitems) - pstarts[ last_menu ] + 1
  77.  
  78.  
  79. *-- copy the altkeys array if it exists
  80. IF TYPE('paltkeys') = 'A'
  81.    ACOPY( paltkeys, pd_altkeys )
  82. ELSE
  83.    *-- otherwise fill it with nulls
  84.    AFILL( pd_altkeys, '' )
  85. ENDIF
  86.  
  87. AFILL( pd_bottoms, 0 )
  88. AFILL( pd_rights,  0 )
  89.  
  90.  
  91. *-- make configuration array public
  92. PUBLIC rl_pd[15]
  93.  
  94. rl_pd[ 1] = LEN(pmenus)                             && N - number of menus (used for offset)
  95. rl_pd[ 2] = ''                                      && C - main menu direct select keys
  96. rl_pd[ 3] = IF(TYPE('pbox')='C', pbox, '┌─┐│┘─└│')  && C - boxing string
  97.  
  98. rl_pd[ 4] = SETCOLOR()                              && save incoming color
  99.  
  100. *-- use <color array> if it is an array AND it has at least 5 elements
  101. IF IF( TYPE('p_colors') = 'A', IF(LEN(p_colors) >= 5, .T., .F.) , .F. )
  102.    rl_pd[ 6] = p_colors[1]              && display color
  103.    rl_pd[ 7] = p_colors[2]              && menu bar color
  104.    rl_pd[ 8] = p_colors[3]              && active pull down menu box color
  105.    rl_pd[ 9] = p_colors[4]              && pull down menu box border after exit
  106.    rl_pd[10] = p_colors[5]              && pull down menu selected option color
  107.  
  108.    rl_pd[ 5] = p_colors[6]              && top bar menu selected option color
  109. ELSE
  110.    rl_pd[ 6] = rl_pd[4]
  111.    rl_pd[ 7] = GETPARM(2, rl_pd[4])
  112.    rl_pd[ 8] = BRIGHT(rl_pd[4])
  113.    rl_pd[ 9] = rl_pd[4]
  114.    rl_pd[10] = rl_pd[8]
  115.  
  116.    rl_pd[ 5] = rl_pd[8]
  117. ENDIF
  118.  
  119.  
  120. *-- window coordinates and buffer
  121. rl_pd[11] = prow                         && N - <maxtop> (top row for main menu)
  122. rl_pd[12] = pcols[1]                     && N - <maxleft>
  123. rl_pd[13] = 0                            && N - <maxbottom>
  124. rl_pd[14] = 0                            && N - <maxright>
  125. rl_pd[15] = ''                           && C - window to hold screen
  126.  
  127.  
  128. *-- display bar menu options and build a list of first letter pick keys
  129. *-- and store coordinates for later fast access, and determine maximum
  130. *-- bottom and right coordinates
  131.  
  132. xjunk = ''
  133. SETCOLOR(rl_pd[6])
  134. @ prow,0                                  && clear option line in that color
  135.  
  136. FOR x = 1 TO LEN(pmenus)
  137.    @ prow,pcols[x] SAY pmenus[x]
  138.    xjunk = xjunk + SUBSTR( LTRIM(pmenus[x]),1,1 )                && build list of direct pick keys
  139.    pd_bottoms[x] = prow + pd_counts[x] + 2                       && bottom coordinate for this menu
  140.    pd_rights[x]  = pcols[x] + LEN(pitems[pstarts[x]]) + 1           && right coordinate for this menu
  141.    rl_pd[13] = MAX( rl_pd[13], pd_bottoms[x] )
  142.    rl_pd[14] = MAX( rl_pd[14], pd_rights[x]  )
  143.  
  144.    *-- fill direct select strings with default first letters for each menu
  145.    yjunk = ''
  146.    FOR y = 1 TO pd_counts[x]
  147.       yjunk = yjunk + SUBSTR(LTRIM(pitems[pstarts[x]+y-1]),1,1)
  148.    NEXT y
  149.    *-- now add to list passed as parameter, if any
  150.    pd_altkeys[x] = yjunk + pd_altkeys[x]
  151.  
  152. NEXT x
  153.  
  154. *-- set color back to way it was
  155. SETCOLOR(rl_pd[4])
  156.  
  157. *-- main menu direct and alternate select keys
  158. rl_pd[2] = xjunk
  159.  
  160. *-- save screen that was painted with top menu options
  161. rl_pd[15] = SAVESCREEN(rl_pd[11],rl_pd[12],rl_pd[13],rl_pd[14])
  162.  
  163. RETURN (.T.)
  164.  
  165.  
  166.  
  167.  
  168.  
  169. *****************************************************************************
  170. * Function..: PDOWNMENU
  171. * Syntax....: PDOWNMENU( @menu, @item, menus, items, columns, starts;
  172. *                        [, prompts [, exit ] ] )
  173. *
  174. * Notes.....: Pull down menu operation AFTER initialized with PDOWNINIT(...)
  175. *             All but the last two parameters are required!  If the <prompts>
  176. *             are not used, but <exit> is, pass a dummy parameter for <prompts>
  177. *
  178. * Parameters: @menu   - pointer to NUMERIC indicating starting top menu option
  179. *             @item   - pointer to NUMERIC starting menu item (if any) 0 = stay in top
  180. *             menus   - ARRAY of top level menu option choices.
  181. *             items   - ARRAY of pulled down menu items.
  182. *             columns - ARRAY of column numbers for each top level option.
  183. *             starts  - ARRAY of starting element numbers.
  184. *             prompts - Optional ARRAY corresponding menu item messages.
  185. *             exit    - Optional LOGICAL indicating if escape will exit.
  186. *                       Default is True.
  187. *
  188. * Returns...:
  189. *
  190. *
  191. *
  192. *****************************************************************************
  193. FUNCTION PDOWNMENU
  194.  
  195. PARAMETERS pullmenu, pullitem, pmenus, pitems, pcols, pstarts, pprompts, pexit
  196.  
  197. PRIVATE fc_incolor, fc_display, fc_menubar, fc_box_on, fc_box_off,;
  198.         fc_selitem, fc_selmenu
  199.  
  200. *-- verify parameters and types
  201. IF TYPE('pullmenu') + TYPE('pullitem') + TYPE('pmenus') +;
  202.    TYPE('pitems')   + TYPE('pstarts')  + TYPE('pcols')  != 'NNAAAA'
  203.    RETURN 0
  204. ENDIF
  205.  
  206. prmts_on = IF( TYPE('pprompts') = 'A', .T.,    .F. )      && if prompts being displayed
  207. prmt_row = IF( TYPE('prmtrow')  = 'N', prmtrow, 24 )      && row for prompt messages
  208. pexit    = IF( TYPE('pexit')    = 'L', pexit,  .T. )
  209.  
  210.  
  211. *-- retrieve and store colors